c	sel2	version 1.1
c
c	joel hasbrouck
c
c	torq data selection program
c
c	this program builds a listing file of all trades, quotes, orders,
c	reports and audit records, in chronological order.
c
c	for conversion to other compilers/operating systems, you may
c	need to change the open statements and the subroutine getcline.
$large
	include 'sel2.cmb'
	include 'torqfils.cmb'
	integer*4 nsym,isym,idate,nrecmap,ksecmid

c	get & echo command line parameters
	call getcline
	write(*,*) 'sel2 v. 1.1 command line:'
	write(*,101) symbol1,symbol2,tdate1,tdate2,selcode,time1,time2
101	format(' sel2',2(1x,a3),2i7,1x,a4,2i7.6)
	write(*,*) 'Input parameters:'
	write(*,*) 'Retrieving symbols from ',symbol1, ' to ',symbol2
	write(*,*) 'Retrieving dates from ',tdate1,' to ',tdate2
	write(*,*) 'Selecting: ',selcode
	write(*,105) time1,time2
105	format(' Retrieving times from ',i6.6,' to ',i6.6,
     $	' (hhmmss past midnight)')
	time1 = ksecmid(time1)
	time2 = ksecmid(time2)

c	open all files
	call fopen

c	loop over name file to read in all symbols
	do 10 nsym=1,150
	read(krnm,100,end=11) symbolnm
100	format(a3)
10	fsym(nsym) = symbolnm
11	nsym = nsym - 1

c	loop over symbols, checking to see if data should be retrieved.
	do 20 isym=1,nsym
	if (fsym(isym).lt.symbol1 .or. fsym(isym).gt.symbol2) goto 20
	write(*,*) 'retrieving data for ',fsym(isym),' . . .'

c	loop over all dates.
	do 21 idate=1,63
c	read in map record for symbol/date
	nrecmap = (isym-1)*63 + idate
	read(krmap,rec=nrecmap) symbolmp,tdatemp,ct1,ct2,nct,cq1,cq2,ncq,
     $	cd1,cd2,ncd,sd1,sd2,nsd

c	is this date in valid range?
	if (tdatemp.lt.tdate1 .or. tdatemp.gt.tdate2) goto 21
	write(*,*) 'retrieving data for ',tdatemp

	nevent = 0

c	open scratch files.
	call sopen

c	read all the data & build array of pointers for sorting
c
c	each pointer is a real*8 variable that contains times, event types,
c	and record numbers. the pointers are placed in the array evptr.
c
	if (getct) call readct
	if (getcq) call readcq
	if (getcd) call readcd
	if (getsod) call readsd

	if (nevent.eq.0) then
		write(*,*) 'nothing found.'
		stop
	else
		write(*,*) nevent,' events found'
	endif
	
c	sort pointers
	call dsort(nevent,evptr)

c	print events, in sorted order
	call eprint

c	close scratch files
	close (unit=ksct)
	close (unit=kscq)
	close (unit=kscd)
	close (unit=kssod)

c	end of date loop.
21	continue

c	end of symbol loop.
20 	continue

	write(*,110)
110	format(' output data written to file sel2.asc.')
	
	end
c--------------------------------------------------------------------------
	subroutine readct
c
c	get transaction records. write to scratch file.
	include 'sel2.cmb'
	include 'torqfils.cmb'
	integer*4 i,nrecct,nctw

	nctw = 0
	if (nct.eq.0) goto 99
	do 10 i=1,nct
	nrecct = ct1 + i - 1
	read(krct,rec=nrecct) condct,exct,g127,pricect,sizct,
     $	symbolct,tdatect,tseq,ttim,null01
	if (ttim.lt.time1) goto 10
	if (ttim.gt.time2) goto 99
	nevent = nevent + 1
	if (nevent.gt.nemax) then
		write(*,*) 'capacity exceeded.'
		write(*,*) 'try changing start/end times',
     $		' to get a smaller sample.'
		stop
	endif
	nctw = nctw + 1
	write(ksct,rec=nctw) condct,exct,g127,pricect,sizct,
     $	symbolct,tdatect,tseq,ttim,null01
	evptr(nevent) = dble(1000000.*ttim) + dble(400000.) + dble(nctw)
10	continue
99	write(*,*) nctw,' transactions'
	return
	end
c--------------------------------------------------------------------------
	subroutine readcq
c	get times for quote records.
	include 'sel2.cmb'
	include 'torqfils.cmb'
	integer*4 i,nreccq,ncqw

	ncqw = 0
	if (ncq.eq.0) goto 99
	do 10 i=1,ncq
	nreccq = cq1 + i - 1
	read(krcq,rec=nreccq) symbolcq,tdatecq,qtim,bid,ofr,
     $	bidsiz,ofrsiz,mode,qseq,excq,null02
	if (qtim.lt.time1) goto 10
	if (qtim.gt.time2) goto 99
	nevent = nevent + 1
	if (nevent.gt.nemax) then
		write(*,*) 'capacity exceeded. try a smaller sample.'
		stop
	endif
	ncqw = ncqw + 1
	write(kscq,rec=ncqw) symbolcq,tdatecq,qtim,bid,ofr,
     $	bidsiz,ofrsiz,mode,qseq,excq,null02
	evptr(nevent) = dble(1000000.*qtim) + dble(500000.) + dble(ncqw)
10	continue
99	write(*,*) ncqw,' quotes'
	return
	end
c--------------------------------------------------------------------------
	subroutine readcd
c	read/write data for audit trail record.
	include 'sel2.cmb'
	include 'torqfils.cmb'
	integer*4 i,nreccd,ncdw
	logical swrite

	ncdw = 0
	if (ncd.eq.0) goto 99
	do 10 i=1,ncd
	swrite = .false.
	nreccd = cd1 + i - 1
	read(krcd,rec=nreccd) btype,buyacct,null08,buycomp,
     $	buytim,condcd,corr,excd,origsiz,pricecd,selacct,
     $	null09,selcomp,seltim,seqnum,sizcd,stype,subseq,symbolcd,
     $	tdatecd,ttimcd
	if (ttimcd.ge.time1 .and. ttimcd.le.time2) then
		nevent = nevent + 1
		if (nevent.gt.nemax) then
			write(*,*) 'capacity exceeded. try a smaller sample.'
			stop
		endif
		if (.not.swrite) then
		ncdw = ncdw + 1
		write(kscd,rec=ncdw) btype,buyacct,null08,buycomp,
     $	buytim,condcd,corr,excd,origsiz,pricecd,selacct,
     $	null09,selcomp,seltim,seqnum,sizcd,stype,subseq,symbolcd,
     $	tdatecd,ttimcd
		swrite = .true.
		endif
		evptr(nevent)=dble(1000000.*ttimcd)+dble(600000.)+dble(ncdw)
	endif
10	continue
99	write(*,*) ncdw,' audit records'
	return
	end
c--------------------------------------------------------------------------
	subroutine readsd
c	read/write sod record.
	include 'sel2.cmb'
	include 'torqfils.cmb'
	integer*4 j,nrecsod,nsdw
	logical swrite

	nsdw = 0
	if (nsd.eq.0) goto 99
	do 10 j=1,nsd
	swrite = .false.
	nrecsod = sd1 + j - 1
	read(krsod,rec=nrecsod) acctyp,aprice,atime,atype,book,
     $	clrcode,null06,conqty,contra,cxlqty,null10,execpr,null04,
     $	flrind,ind,indtot,lmtpr,lvsqty,ocode,ocond,odate,omni,
     $	oqual,order,oshrs,oside,otime,null05,rshrs,rtime,stppr,
     $	symbolsd,null07,tdatesd,tif
	if (otime.gt.0 .and. otime.ge.time1 .and. otime.le.time2) then
		nevent = nevent + 1
		if (nevent.gt.nemax) then
			write(*,*) 'capacity exceeded. try a smaller sample.'
			stop
		endif
		if (.not.swrite) then
			nsdw = nsdw + 1
			write(kssod,rec=nsdw) acctyp,aprice,atime,atype,book,
     $	clrcode,null06,conqty,contra,cxlqty,null10,execpr,null04,
     $	flrind,ind,indtot,lmtpr,lvsqty,ocode,ocond,odate,omni,
     $	oqual,order,oshrs,oside,otime,null05,rshrs,rtime,stppr,
     $	symbolsd,null07,tdatesd,tif
			swrite = .true.
		endif
		evptr(nevent)=dble(1000000.*otime)+dble(100000.)+dble(nsdw)
	endif
	if (atime.gt.0 .and. atime.ge.time1 .and. atime.le.time2) then
		nevent = nevent + 1
		if (nevent.gt.nemax) then
			write(*,*) 'capacity exceeded. try a smaller sample.'
			stop
		endif
		if (.not.swrite) then
			nsdw = nsdw + 1
			write(kssod,rec=nsdw) acctyp,aprice,atime,atype,book,
     $	clrcode,null06,conqty,contra,cxlqty,null10,execpr,null04,
     $	flrind,ind,indtot,lmtpr,lvsqty,ocode,ocond,odate,omni,
     $	oqual,order,oshrs,oside,otime,null05,rshrs,rtime,stppr,
     $	symbolsd,null07,tdatesd,tif
			swrite = .true.
		endif
		evptr(nevent)=dble(1000000.*atime)+dble(200000.)+dble(nsdw)
	endif
	if (rtime.gt.0 .and. rtime.ge.time1 .and. rtime.le.time2) then
		nevent = nevent + 1
		if (nevent.gt.nemax) then
			write(*,*) 'capacity exceeded. try a smaller sample.'
			stop
		endif
		if (.not.swrite) then
			nsdw = nsdw + 1
			write(kssod,rec=nsdw) acctyp,aprice,atime,atype,book,
     $	clrcode,null06,conqty,contra,cxlqty,null10,execpr,null04,
     $	flrind,ind,indtot,lmtpr,lvsqty,ocode,ocond,odate,omni,
     $	oqual,order,oshrs,oside,otime,null05,rshrs,rtime,stppr,
     $	symbolsd,null07,tdatesd,tif
			swrite = .true.
		endif
		evptr(nevent)=dble(1000000.*rtime)+dble(300000.)+dble(nsdw)
	endif
10	continue
99	write(*,*) nsdw,' system order database records'
	return
	end
c--------------------------------------------------------------------------
	subroutine eprint
c	print sorted record of events
	include 'sel2.cmb'
	include 'torqfils.cmb'
	integer*4 etime,etype,erec,ievent
	character*8 chhmmss

	if (nevent.eq.0) goto 99
	do 10 ievent=1,nevent
	etime = evptr(ievent)/1000000. + .1
	etype = mod(evptr(ievent),1000000.)/100000. + .1
	erec = mod(evptr(ievent),100000.) + .1

	if (etype.eq.1) then
		write(kw,100) chhmmss(etime)
100		format(/'order entry at ',a8,'. sod record is:')
		call rwsod(erec)
	else if (etype.eq.2) then
		write(kw,101) chhmmss(etime)
101		format(/'administrative response at ',a8,'. sod record is:')
		call rwsod(erec)
	else if (etype.eq.3) then
		write(kw,102) chhmmss(etime)
102		format(/'report at ',a8,'. sod record is:')
		call rwsod(erec)
	else if (etype.eq.4) then
		write(kw,103) chhmmss(etime)
103		format(/'transaction print at ',a8,'. ct record is:')
		call rwct(erec)
	else if (etype.eq.5) then
		write(kw,104) chhmmss(etime)
104		format(/'quote at ',a8,'. cq record is:')
		call rwcq(erec)
	else if (etype.eq.6) then
		write(kw,105) chhmmss(etime)
105		format(/'audit record at ',a8,
     $		'. cd (audit trail) record is:')
		call rwcd(erec)
	else
		write(*,110) evptr(ievent),etime,etype,erec
110		format('eprint error:',f15.0,3i6)
		stop
	endif
10	continue
99	return
	end
c--------------------------------------------------------------------------
	subroutine rwct(nrecct)
c	read/write data for transaction record.
	include 'sel2.cmb'
	include 'torqfils.cmb'
	integer*4 nrecct
	character*8 chhmmss
	read(ksct,rec=nrecct) condct,exct,g127,pricect,sizct,
     $	symbolct,tdatect,tseq,ttim,null01
	write(kw,100) symbolct,tdatect,chhmmss(ttim),exct,
     $	float(pricect)/256.,sizct,condct,g127,tseq
100		format(a3,i7,1x,a8,1x,a1,f11.5,i7,' cond:',a1,
     $	' g127:',i3,' tseq:',i6)
99	return
	end
c--------------------------------------------------------------------------
	subroutine rwcq(nreccq)
c	read/write data for quote record.
	include 'sel2.cmb'
	include 'torqfils.cmb'
	integer*4 nreccq
	character chhmmss*8

	read(kscq,rec=nreccq) symbolcq,tdatecq,qtim,bid,ofr,
     $	bidsiz,ofrsiz,mode,qseq,excq,null02
	write(kw,101) symbolcq,tdatecq,chhmmss(qtim),excq,
     $	float(bid)/256.,bidsiz,float(ofr)/256.,ofrsiz,
     $	mode,qseq
101	format(a3,i7,1x,a8,1x,a1,' bid',f10.5,i4,' ofr',f10.5,i4,
     $	' mode',i4,' qseq',i7)
	return
	end
c--------------------------------------------------------------------------
	subroutine rwcd(nreccd)
c	read/write data for audit trail record.
	include 'sel2.cmb'
	include 'torqfils.cmb'
	integer*4 nreccd
	character chhmmss*8

	read(kscd,rec=nreccd) btype,buyacct,null08,buycomp,
     $	buytim,condcd,corr,excd,origsiz,pricecd,selacct,
     $	null09,selcomp,seltim,seqnum,sizcd,stype,subseq,symbolcd,
     $	tdatecd,ttimcd

	write(kw,100)
100	format('symbol  tdate     ttim     price    siz  seqnum',
     $	' subseq cond corr ex origsiz')
	write(kw,101) symbolcd,tdatecd,chhmmss(ttimcd),
     $	float(pricecd)/256.,sizcd,seqnum,subseq,condcd,corr,excd,
     $	origsiz
101	format(3x,a3,i7,1x,a8,f11.5,i7,i8,i7,4x,a1,3x,a2,2x,a1,i8)
	write(kw,102)
102	format('btype buyacct   buytim buycomp',
     $	' selcomp   seltim selacct stype')
	write(kw,103) btype,buyacct,chhmmss(buytim),buycomp,
     $	selcomp,chhmmss(seltim),selacct,stype
103	format(3x,a2,7x,a1,1x,a8,i8,i8,1x,a8,7x,a1,4x,a2)
	return
	end
c--------------------------------------------------------------------------
	subroutine rwsod(nrecsod)
c	read/write sod record.
	include 'sel2.cmb'
	include 'torqfils.cmb'
	integer*4 i,nrecsod
	character chhmmss*8

	read(kssod,rec=nrecsod) acctyp,aprice,atime,atype,book,
     $	clrcode,null06,conqty,contra,cxlqty,null10,execpr,null04,
     $	flrind,ind,indtot,lmtpr,lvsqty,ocode,ocond,odate,omni,
     $	oqual,order,oshrs,oside,otime,null05,rshrs,rtime,stppr,
     $	symbolsd,null07,tdatesd,tif

	write(kw,100)
100	format(' symbol  tdate  odate    otime order ind indtot flrind',
     $	' book omni clrcode')
	write(kw,101) symbolsd,tdatesd,odate,chhmmss(otime),order,
     $	ind,indtot,flrind,book,omni
101	format(4x,a3,i7,i7,1x,a8,5x,a1,i4,i7,6x,a1,4x,a1,4x,a1,6x,a2)
	write(kw,102)
102	format(' oside ocode ocond oshrs     lmtpr     stppr acctyp tif',
     $	' oqual')
	write(kw,103) oside,ocode,ocond,oshrs,float(lmtpr)/256.,
     $	float(stppr)/256.,acctyp,tif,oqual
103	format(3x,a3,4x,a2,5x,a1,i6,2f10.5,6x,a1,3x,a1,i6)
	write(kw,104)
104	format(' atype    atime    aprice cxlqty',
     $	'    rtime rshrs    execpr lvsqty ')
	write(kw,105) atype,chhmmss(atime),float(aprice)/256.,
     $	cxlqty,chhmmss(rtime),rshrs,float(execpr)/256.,lvsqty
105	format(5x,a1,1x,a8,f10.5,i7,1x,a8,i6,f10.5,i7)
	write(kw,108) 
108	format('  conqty1 contra1 conqty2 contra2',
     $	' conqty3 contra3 conqty4 contra4')
	write(kw,109) (conqty(i),contra(i),i=1,4)
109	format(1x,4(i8,4x,a4))

	return
	end
c--------------------------------------------------------------------------
	subroutine fopen
c	open files used by the program.
c	dirdat is the directory prefix to input file names.
	include 'sel2.cmb'
	logical lexist

c	open input torq files.
	call tfilopen

c	output file:
	kw = 10
	inquire (file='sel2.asc',exist=lexist)
	if (lexist) then
		open (unit=kw,file='sel2.asc',status='old')
		close (unit=kw,status='delete')
	endif
	open (unit=kw,file='sel2.asc',status='new')
	end
c--------------------------------------------------------------------------
	subroutine sopen
c	open scratch files used by the program.
	include 'sel2.cmb'
	ksct = 11
	open (unit=ksct,recl=31,access='direct',form='unformatted')
	kscq = 12
	open (unit=kscq,recl=31,access='direct',form='unformatted')
	kscd = 13
	open (unit=kscd,recl=59,access='direct',form='unformatted')
	kssod = 14
	open (unit=kssod,recl=119,access='direct',form='unformatted')
	return
	end
c--------------------------------------------------------------------------
	subroutine getcline

c	gets command line parameters.
c
c	form of command line is:
c	select symbol1 symbol2 tdate1 tdate2 time1 time2 selcode
c	where
c	symbol1		first symbol to retrieve
c	symbol2		last symbol
c	tdate1		first tdate to retrieve (YYMMDD)
c	tdate2		last tdate
c	selcode	 	some combination of the characters T, Q, S, A
c				(for trade, quote, sod, audit)
c	time1		first time (HHMMSS)
c	time2		last time
c	
c	this subprogram contains a lot of ms-dos fortran specific code.
c	if you are modifying the program for another machine or compiler,
c	this routine must be changed. Of course, in your particular application
c	there may be no need to get the arguments from the command line.
c	you may wish to have them permanently set in the program, or else you
c	might read them in from another file.

	include 'sel2.cmb'
	integer*2 istat
	integer*4 na,nargs
	character buffer*20,upper*20

c	these are the defaults:
	symbol1 = 'AC'
	symbol2 = 'AC'
	tdate1 = 901101
	tdate2 = 901101
	time1 = 000000
	time2 = 235900
	selcode = 'TQ'

	buffer = '         '
	na = nargs() - 1
	if (na.gt.0) call getarg(1,symbol1,istat)
	symbol1 = upper(symbol1)
	if (na.gt.1) call getarg(2,symbol2,istat)
	symbol2 = upper(symbol2)
	if (symbol2.lt.symbol1) symbol2 = symbol1
	if (na.gt.2) then
		call getarg(3,buffer,istat)
		read(buffer,'(i6)') tdate1
	endif
	if (na.gt.3) then
		call getarg(4,buffer,istat)
		read(buffer,'(i6)') tdate2
	endif
	if (tdate2.lt.tdate1) tdate2 = tdate1
	getct = .true.
	getcq = .true.
	getsod = .false.
	getcd = .false.
	if (na.gt.4) then
		call getarg(5,selcode,istat)
		selcode = upper(selcode)
		if (index(selcode,'T').eq.0) getct = .false.
		if (index(selcode,'Q').eq.0) getcq = .false.
		if (index(selcode,'S').gt.0) getsod = .true.
		if (index(selcode,'A').gt.0) getcd = .true.
	endif
	if (na.gt.5) then
		call getarg(6,buffer,istat)
		read(buffer,'(i6)') time1
	endif
	if (na.gt.6) then
		call getarg(7,buffer,istat)
		read(buffer,'(i6)') time2
	endif
	if (time2.lt.time1) time2 = time1

	return
	end
c--------------------------------------------------------------------------
	subroutine dsort(n,a)
	real*8 a(n),ra
	if (n.eq.0) return
	l = n/2 + 1
	ir = n
10	continue
	if (l.gt.1) then
		l = l - 1
		ra = a(l)
	else
		ra = a(ir)
		a(ir) = a(1)
		ir = ir - 1
		if (ir.eq.1) then
			a(1) = ra
			return
		endif
	endif
	i = l
	j = l + l
20	if (j.le.ir) then
		if (j.lt.ir) then
			if (a(j).lt.a(j+1)) j = j + 1
		endif
		if (ra.lt.a(j)) then
			a(i) = a(j)
			i = j
			j = j + j
		else
			j = ir + 1
		endif
		goto 20
	endif
	a(i) = ra
	goto 10
	end

	include 'torqsubs.for'